home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / passwd.el.z / passwd.el
Encoding:
Text File  |  1998-05-21  |  12.6 KB  |  388 lines
  1. ;;; passwd.el --- Prompting for passwords semi-securely
  2.  
  3. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  4. ;; Keywords: comm, extensions
  5.  
  6. ;; Author: Jamie Zawinski <jwz@netscape.com>
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Change Log:
  25. ;;
  26. ;;  Sun Jun 12 04:19:30 1994 by sandy on ibm550.sissa.it
  27. ;;    Added support for password histories and (provide 'passwd)
  28. ;;    (jwz says: this "history" thing is completely undocumented, you loser!)
  29. ;; 2-Jan-95 (mon); 4:13 AM by jwz@netscape.com
  30. ;;    Fixed Sandy's extreme keymap bogosity.  Made it invert the screen when
  31. ;;    reading securely (this could be better; maybe use red text or something
  32. ;;    instead...)
  33. ;; 9-Jul-95 (fri); 4:55 AM by jwz@netscape.com
  34. ;;    Made it work with XEmacs 19.12.
  35. ;; 7-Jul-95 by cthomp@cs.uiuc.edu
  36. ;;    Added variable to control inverting frame when keyboard grabbed
  37.  
  38. ;;; Code:
  39.  
  40. (defgroup passwd nil
  41.   "Prompting for passwords semi-securely"
  42.   :group 'processes)
  43.  
  44.  
  45. (defcustom passwd-invert-frame-when-keyboard-grabbed (not (featurep 'infodock))
  46.   "*If non-nil swap the foreground and background colors of all faces.
  47. This is done while the keyboard is grabbed in order to give a visual
  48. clue that a grab is in effect."
  49.   :type 'boolean
  50.   :group 'passwd)
  51.  
  52. (defcustom passwd-echo ?.
  53.   "*The character which should be echoed when typing a password,
  54. or nil, meaning echo nothing."
  55.   :type 'sexp
  56.   :group 'passwd)
  57.  
  58. (defvar read-passwd-map
  59.   (let ((i 0)
  60.     (s (make-string 1 0))
  61.     map)
  62.     (cond ((fboundp 'set-keymap-parent)
  63.        (setq map (make-keymap))
  64.        (set-keymap-parent map minibuffer-local-map))
  65.       (t  ; v18/FSFmacs compatibility
  66.        (setq map (copy-keymap minibuffer-local-map))))
  67.     (if (fboundp 'set-keymap-name)
  68.     (set-keymap-name map 'read-passwd-map))
  69.  
  70.     (while (< i 127)
  71.       (aset s 0 i)
  72.       (or (and (boundp 'meta-prefix-char) (eq (int-char i) meta-prefix-char))
  73.       (define-key map s 'self-insert-command))
  74.       (setq i (1+ i)))
  75.  
  76.     (define-key map "\C-g" 'keyboard-quit)
  77.     (define-key map "\C-h" 'delete-backward-char)
  78.     (define-key map "\r" 'exit-minibuffer)
  79.     (define-key map "\n" 'exit-minibuffer)
  80.     (define-key map "\C-u" 'passwd-erase-buffer)
  81.     (define-key map "\C-q" 'quoted-insert)
  82.     (define-key map "\177" 'delete-backward-char)
  83.     (define-key map "\M-n" 'passwd-next-history-element)
  84.     (define-key map "\M-p" 'passwd-previous-history-element)
  85.     map)
  86.   "Keymap used for reading passwords in the minibuffer.
  87. The \"bindings\" in this map are not real commands; only a limited
  88. number of commands are understood.  The important bindings are:
  89. \\<read-passwd-map>
  90.     \\[passwd-erase-buffer]    Erase all input.
  91.     \\[quoted-insert]    Insert the next character literally.
  92.     \\[delete-backward-char]    Delete the previous character.
  93.     \\[exit-minibuffer]    Accept what you have typed.
  94.     \\[keyboard-quit]    Abort the command.
  95.  
  96. All other characters insert themselves (but do not echo.)")
  97.  
  98. ;;; internal variables
  99.  
  100. (defvar passwd-history nil)
  101. (defvar passwd-history-posn 0)
  102.  
  103. ;;;###autoload
  104. (defun read-passwd (prompt &optional confirm default)
  105.   "Prompts for a password in the minibuffer, and returns it as a string.
  106. If PROMPT may be a prompt string or an alist of elements 
  107. '\(prompt . default\).
  108. If optional arg CONFIRM is true, then ask the user to type the password
  109. again to confirm that they typed it correctly.
  110. If optional arg DEFAULT is provided, then it is a string to insert as
  111. the default choice (it is not, of course, displayed.)
  112.  
  113. If running under X, the keyboard will be grabbed (with XGrabKeyboard())
  114. to reduce the possibility that eavesdropping is occuring.
  115.  
  116. When reading a password, all keys self-insert, except for:
  117. \\<read-passwd-map>
  118.     \\[read-passwd-erase-line]    Erase the entire line.
  119.     \\[quoted-insert]    Insert the next character literally.
  120.     \\[delete-backward-char]    Delete the previous character.
  121.     \\[exit-minibuffer]    Accept what you have typed.
  122.     \\[keyboard-quit]    Abort the command.
  123.  
  124. The returned value is always a newly-created string.  No additional copies
  125. of the password remain after this function has returned.
  126.  
  127. NOTE: unless great care is taken, the typed password will exist in plaintext
  128. form in the running image for an arbitrarily long time.  Priveleged users may
  129. be able to extract it from memory.  If emacs crashes, it may appear in the
  130. resultant core file.
  131.  
  132. Some steps you can take to prevent the password from being copied around:
  133.  
  134.  - as soon as you are done with the returned string, destroy it with
  135.    (fillarray string 0).  The same goes for any default passwords
  136.    or password histories.
  137.  
  138.  - do not copy the string, as with concat or substring - if you do, be
  139.    sure to keep track of and destroy all copies.
  140.  
  141.  - do not insert the password into a buffer - if you do, be sure to 
  142.    overwrite the buffer text before killing it, as with the functions 
  143.    `passwd-erase-buffer' or `passwd-kill-buffer'.  Note that deleting
  144.    the text from the buffer does NOT necessarily remove the text from
  145.    memory.
  146.  
  147.  - be careful of the undo history - if you insert the password into a 
  148.    buffer which has undo recording turned on, the password will be 
  149.    copied onto the undo list, and thus recoverable.
  150.  
  151.  - do not pass it as an argument to a shell command - anyone will be
  152.    able to see it if they run `ps' at the right time.
  153.  
  154. Note that the password will be temporarily recoverable with the `view-lossage'
  155. command.  This data will not be overwritten until another hundred or so 
  156. characters are typed.  There's not currently a way around this."
  157.  
  158.   (save-excursion
  159.     (let ((input (get-buffer-create " *password*"))
  160.       (passwd-history-posn 0)
  161.       passwd-history)
  162.       (if (listp prompt)
  163.       (setq passwd-history prompt
  164.         default (cdr (car passwd-history))))
  165.       (set-buffer input)
  166.       (buffer-disable-undo input)
  167.       (use-local-map read-passwd-map)
  168.       (unwind-protect
  169.       (progn
  170.         (if (passwd-grab-keyboard)
  171.         (passwd-secure-display))
  172.         (read-passwd-1 input prompt nil default)
  173.         (set-buffer input)
  174.  
  175.         (if (not confirm)
  176.         (buffer-string)
  177.           (let ((ok nil)
  178.             passwd)
  179.         (while (not ok)
  180.           (set-buffer input)
  181.           (setq passwd (buffer-string))
  182.           (read-passwd-1 input prompt "[Retype to confirm]")
  183.           (if (passwd-compare-string-to-buffer passwd input)
  184.               (setq ok t)
  185.             (fillarray passwd 0)
  186.             (setq passwd nil)
  187.             (beep)
  188.             (read-passwd-1 input prompt "[Mismatch. Start over]")
  189.             ))
  190.         passwd)))
  191.     ;; protected
  192.     (passwd-ungrab-keyboard)
  193.     (passwd-insecure-display)
  194.     (passwd-kill-buffer input)
  195.     (message "")
  196.     ))))
  197.  
  198.  
  199. (defun read-passwd-1 (buffer prompt &optional prompt2 default)
  200.   (set-buffer buffer)
  201.   (passwd-erase-buffer)
  202.   (if default (insert default))
  203.   (catch 'exit ; exit-minibuffer throws here
  204.     (while t
  205.       (set-buffer buffer)
  206.       (let* ((minibuffer-completion-table nil)
  207.          (cursor-in-echo-area t)
  208.          (echo-keystrokes 0)
  209.          (key (passwd-read-key-sequence
  210.            (concat (if (listp prompt)
  211.                    (car (nth passwd-history-posn passwd-history))
  212.                  prompt)
  213.                prompt2
  214.                (if passwd-echo
  215.                    (make-string (buffer-size) passwd-echo)))))
  216.          (binding (key-binding key)))
  217.     (setq prompt2 nil)
  218.     (set-buffer buffer)        ; just in case...
  219.     (if (fboundp 'event-to-character) ;; lemacs
  220.         (setq last-command-event (aref key (1- (length key)))
  221.           last-command-char (event-to-character last-command-event))
  222.       ;; v18/FSFmacs compatibility
  223.       (setq last-command-char (aref key (1- (length key)))))
  224.     (setq this-command binding)
  225.     (condition-case c
  226.         (command-execute binding)
  227.       (error
  228.        (beep)
  229.        (if (fboundp 'display-error)
  230.            (display-error c t)
  231.          ;; v18/FSFmacs compatibility
  232.          (message (concat (or (get (car-safe c) 'error-message) "???")
  233.                   (if (cdr-safe c) ": ")
  234.                   (mapconcat 
  235.                    (function (lambda (x) (format "%s" x)))
  236.                    (cdr-safe c) ", "))))
  237.        (sit-for 2)))
  238.     ))))
  239.  
  240. (defun passwd-previous-history-element (n)
  241.   (interactive "p")
  242.   (or passwd-history
  243.       (error "Password history is empty."))
  244.   (let ((l (length passwd-history)))
  245.     (setq passwd-history-posn
  246.       (% (+ n passwd-history-posn) l))
  247.     (if (< passwd-history-posn 0)
  248.     (setq passwd-history-posn (+ passwd-history-posn l))))
  249.   (let ((obuff (current-buffer))) ; want to move point in passwd buffer
  250.     (unwind-protect
  251.     (progn
  252.       (set-buffer " *password*")
  253.       (passwd-erase-buffer)
  254.       (insert (cdr (nth passwd-history-posn passwd-history))))
  255.       (set-buffer obuff))))
  256.  
  257. (defun passwd-next-history-element (n)
  258.   (interactive "p")
  259.   (passwd-previous-history-element (- n)))
  260.  
  261. (defun passwd-erase-buffer ()
  262.   ;; First erase the buffer, which will simply enlarge the gap.
  263.   ;; Then insert null characters until the gap is filled with them
  264.   ;; to prevent the old text from being visible in core files or kmem.
  265.   ;; (Actually use 3x the size of the buffer just to be safe - a longer
  266.   ;; passwd might have been typed and backspaced over.)
  267.   (interactive)
  268.   (widen)
  269.   (let ((s (* (buffer-size) 3)))
  270.     (erase-buffer)
  271.     (while (> s 0)
  272.       (insert ?\000)
  273.       (setq s (1- s)))
  274.     (erase-buffer)))
  275.  
  276. (defun passwd-kill-buffer (buffer)
  277.   (save-excursion
  278.     (set-buffer buffer)
  279.     (buffer-disable-undo buffer)
  280.     (passwd-erase-buffer)
  281.     (set-buffer-modified-p nil))
  282.   (kill-buffer buffer))
  283.  
  284.  
  285. (defun passwd-compare-string-to-buffer (string buffer)
  286.   ;; same as (equal string (buffer-string)) but with no dangerous consing.
  287.   (save-excursion
  288.     (set-buffer buffer)
  289.     (goto-char (point-min))
  290.     (let ((L (length string))
  291.       (i 0))
  292.       (if (/= L (- (point-max) (point-min)))
  293.       nil
  294.     (while (not (eobp))
  295.       (if (/= (following-char) (aref string i))
  296.           (goto-char (point-max))
  297.         (setq i (1+ i))
  298.         (forward-char)))
  299.     (= (point) (+ i (point-min)))))))
  300.  
  301.  
  302. (defvar passwd-face-data nil)
  303. (defun passwd-secure-display ()
  304.   ;; Inverts the screen - used to indicate secure input, like xterm.
  305.   (cond
  306.    ((and passwd-invert-frame-when-keyboard-grabbed
  307.      (fboundp 'set-face-foreground))
  308.     (setq passwd-face-data
  309.       (delq nil (mapcar (function
  310.                  (lambda (face)
  311.                    (let ((fg (face-foreground face))
  312.                      (bg (face-background face)))
  313.                  (if (or fg bg)
  314.                      (if (fboundp 'color-name)
  315.                      (list face
  316.                            (color-name fg)
  317.                            (color-name bg))
  318.                        (list face fg bg))
  319.                    nil))))
  320.                 (face-list)
  321.                   )))
  322.     (let ((rest passwd-face-data))
  323.       (while rest
  324.     (set-face-foreground (nth 0 (car rest)) (nth 2 (car rest)))
  325.     (set-face-background (nth 0 (car rest)) (nth 1 (car rest)))
  326.     (setq rest (cdr rest))))))
  327.   nil)
  328.  
  329. (defun passwd-insecure-display ()
  330.   ;; Undoes the effect of `passwd-secure-display'.
  331.   (cond
  332.    (passwd-invert-frame-when-keyboard-grabbed
  333.     (while passwd-face-data
  334.       (set-face-foreground (nth 0 (car passwd-face-data))
  335.                (nth 1 (car passwd-face-data)))
  336.       (set-face-background (nth 0 (car passwd-face-data))
  337.                (nth 2 (car passwd-face-data)))
  338.       (setq passwd-face-data (cdr passwd-face-data)))
  339.     nil)))
  340.  
  341. (defun passwd-grab-keyboard ()
  342.   (cond ((not (and (fboundp 'x-grab-keyboard) ; lemacs 19.10+
  343.            (eq 'x (if (fboundp 'frame-type)
  344.                   (frame-type (selected-frame))
  345.                 (frame-live-p (selected-frame))))))
  346.      nil)
  347.     ((x-grab-keyboard)
  348.      t)
  349.     (t
  350.      (message "Unable to grab keyboard - waiting a second...")
  351.      (sleep-for 1)
  352.      (cond ((x-grab-keyboard)
  353.         (message "Keyboard grabbed on second try.")
  354.         t)
  355.            (t
  356.         (beep)
  357.         (message "WARNING: keyboard is insecure (unable to grab!)")
  358.         (sleep-for 3)
  359.         nil)))))
  360.  
  361. (defun passwd-ungrab-keyboard ()
  362.   (if (and (fboundp 'x-ungrab-keyboard) ; lemacs 19.10+
  363.        (eq 'x (if (fboundp 'frame-type)
  364.               (frame-type (selected-frame))
  365.             (frame-live-p (selected-frame)))))
  366.       (x-ungrab-keyboard)))
  367.  
  368. ;; v18 compatibility
  369. (or (fboundp 'buffer-disable-undo)
  370.     (fset 'buffer-disable-undo 'buffer-flush-undo))
  371.  
  372. ;; read-key-sequence echoes the key sequence in Emacs 18.
  373. (defun passwd-read-key-sequence (prompt)
  374.   (let ((inhibit-quit t)
  375.     str)
  376.     (while (or (null str) (keymapp (key-binding str)))
  377.       (message prompt)
  378.       (setq str (concat str (char-to-string (read-char)))))
  379.     (setq quit-flag nil)
  380.     str))
  381.  
  382. (or (string-match "^18" emacs-version)
  383.     (fset 'passwd-read-key-sequence 'read-key-sequence))
  384.  
  385. (provide 'passwd)
  386.  
  387. ;;; passwd.el ends here
  388.